home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / 4cmp22s.zip / QUEENS.4TH < prev    next >
Text File  |  1994-10-30  |  2KB  |  65 lines
  1. \ Eight Queens Problem, by Jerry Levan,  from Forth Dimensions II/1 page 6
  2.  
  3. \ NOTE: DEFINE CONSTANT IBM-COMPAT TO BE FALSE IF NOT IBM COMPATIBLE
  4.     
  5. \ DEFINE THE CONSTANT PRINTIT TO BE FALSE IF NO PRINTING OF RESULTS
  6. \ IS DESIRED (FASTER FOR BENCHMARKING)
  7.  
  8. \ DEFINE THE CONSTANT VID-DELAY TO BE TRUE IF SCREEN IS SNOWY
  9.  
  10. 128 MSDOS
  11. FIND PRINTIT [IF] DROP [ELSE] TRUE CONSTANT PRINTIT [THEN]
  12. FIND IBM-COMPAT [IF] DROP [ELSE] TRUE CONSTANT IBM-COMPAT [THEN]
  13.  
  14. IBM-COMPAT [IF] INCLUDE DISPLAY1 [THEN]
  15.  
  16. 8  ARRAY A
  17. 16 ARRAY B
  18. 16 ARRAY C
  19. 8  ARRAY X
  20.  
  21. H:  FILLARRAY  ( address cells -- , fill with 1's )
  22.     0 DO  -1 OVER !  CELL+ LOOP  DROP ;
  23.  
  24. 0 A  8 FILLARRAY  
  25. 0 B 16 FILLARRAY  
  26. 0 C 16 FILLARRAY
  27. 0 X  8 FILLARRAY
  28.  
  29. 2 1 IN/OUT
  30. : SAFE  DUP A @ IF SWAP 2DUP - 7 + C @ IF + B @ EXIT THEN THEN
  31.      2DROP 0 ;
  32.  
  33. 2 0 IN/OUT
  34. : MARK  SWAP  2DUP 2DUP - 7 + C OFF
  35.    + B OFF   DROP  A OFF ; 
  36.  
  37. 2 0 IN/OUT
  38. : UNMARK  SWAP  2DUP 2DUP - 7 + C ON
  39.    + B ON  DROP  A ON ;
  40.  
  41. VARIABLE TRIES
  42. PRINTIT [IF]
  43. 0 0 IN/OUT
  44. : PRINTSOL  ." found on try " TRIES @ 6 .R   ." : "
  45.   8 0 DO  I X @ 1+ 5 .R LOOP  CR ;
  46. [THEN]
  47.  
  48. 1 0 IN/OUT
  49. : TRY  8 0 DO  1 TRIES +! 
  50.         DUP I SAFE IF DUP I MARK I OVER X !  DUP 7 <
  51.          IF DUP 1+ TRY ( recurse )
  52.             PRINTIT [IF] ELSE PRINTSOL [THEN]  THEN
  53.        DUP I UNMARK THEN  LOOP  DROP ;
  54.  
  55. : MAIN IBM-COMPAT [IF] SETUP-VID  [THEN]
  56.        0 TRIES ! ." Starting..." CR 0 TRY
  57.       ." Done!"  CR
  58.       IBM-COMPAT [IF] UNSETUP-VID [THEN] ;
  59.  
  60.  
  61. IBM-COMPAT [IF] INCLUDE DISPLAY2 [THEN]
  62. INCLUDE FORTHLIB
  63. END
  64.  
  65.